home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Sample Code / Snippets / QuickDraw / GrayishOutline / GrayishOutline.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  3.7 KB  |  186 lines  |  [TEXT/MPS ]
  1. PROGRAM GrayishOutlines;
  2.  
  3.     USES Dialogs, Fonts, Menus, OSEvents, SegLoad, Traps;
  4.  
  5.     VAR
  6.         gWP: WindowPtr;
  7.         gDone: Boolean;
  8.  
  9.         {------------------------------------------------}
  10.  
  11.     FUNCTION TrapAvailable(theTrap: Integer): Boolean;
  12.         CONST
  13.             _Initgraf = $A86E;
  14.             _Unimplemented = $A89F;
  15.         VAR
  16.             tType: Traptype;
  17.             numToolBoxTraps: Integer;
  18.         BEGIN
  19.         IF Band(theTrap, $0800) > 0 THEN
  20.             BEGIN
  21.             tType := toolTrap;
  22.             theTrap := Band(theTrap, $07FF);
  23.             IF NGetTrapAddress(_Initgraf, toolTrap) = NGetTrapAddress($AA6E, toolTrap) THEN
  24.                 numToolBoxTraps := $200
  25.             ELSE
  26.                 numToolBoxTraps := $400;
  27.             IF theTrap > numToolBoxTraps THEN theTrap := _Unimplemented;
  28.             END
  29.         ELSE
  30.             tType := OSTrap;
  31.         TrapAvailable := (NGetTrapAddress(theTrap, tType) <>
  32.                                          NGetTrapAddress(_Unimplemented, toolTrap));
  33.         END;
  34.  
  35.     {------------------------------------------------}
  36.  
  37.     PROCEDURE InitMac;
  38.         BEGIN
  39.         InitGraf(@thePort);
  40.         InitFonts;
  41.         FlushEvents(everyEvent, 0);
  42.         InitWindows;
  43.         InitMenus;
  44.         TeInit;
  45.         InitDialogs(NIL);
  46.         InitCursor;
  47.         END;
  48.  
  49.     PROCEDURE InitApp;
  50.         CONST
  51.             _DeviceLoop = $ABCA;
  52.             _OpenCPort = $AA00;
  53.             Title = 'Press Key to Quit';
  54.         VAR
  55.             bounds: Rect;
  56.         BEGIN
  57.         IF NOT (TrapAvailable(_Deviceloop) AND TrapAvailable(_Opencport)) THEN
  58.             BEGIN
  59.             SysBeep(20);
  60.             SysBeep(20);
  61.             ExitToShell;
  62.             END;
  63.         gDone := False;
  64.         SetRect(bounds, 10, 50, 310, 250);
  65.         gWP := NewCWindow(NIL, bounds, title, TRUE, documentProc, WindowPtr(-1), TRUE, 0);
  66.         Setport(gWP);
  67.         END;
  68.  
  69.     PROCEDURE DoMouseDown(where: Point);
  70.         VAR
  71.             clickArea: Integer;
  72.             screenRect: Rect;
  73.             evtWind: Windowptr;
  74.         BEGIN
  75.         clickArea := FindWindow(where, evtWind);
  76.         IF clickArea = inDrag THEN
  77.             BEGIN
  78.             screenRect := GetGrayRgn^^.rgnBBox;
  79.             DragWindow(evtWind, Where, screenRect);
  80.             SetPort(evtWind);
  81.             InvalRect(evtWind^.Portrect);
  82.             END
  83.         ELSE IF clickArea = inGoAway THEN
  84.             IF TrackGoAway(evtWind, where) THEN gDone := TRUE
  85.         END;
  86.  
  87.     PROCEDURE Button1;
  88.         VAR
  89.             color: RGBColor;
  90.             pp: PixPatHandle;
  91.             r: Rect;
  92.         BEGIN
  93.         color.Red := $8000;
  94.         color.Green := $8000;
  95.         color.Blue := $8000;
  96.         pp := NewPixPat;
  97.         MakeRGBPat(pp, color);
  98.         PenPixPat(pp);
  99.         PenSize(4, 4);
  100.         SetRect(r, 50, 50, 250, 70);
  101.         FrameRoundRect(r, 10, 10);
  102.         PenNormal;
  103.         MoveTo(60, 65);
  104.         DrawString('PixPat version');
  105.         DisposPixPat(pp);
  106.         END;
  107.  
  108.     PROCEDURE Mydrawingproc(depth: Integer;
  109.                                                     deviceFlags: Integer;
  110.                                                     targetDevice: GDHandle;
  111.                                                     userData: Longint);
  112.         VAR
  113.             color: RGBColor;
  114.             r: Rect;
  115.         BEGIN
  116.         IF depth > 1 THEN
  117.             BEGIN
  118.             color.Red := $8000;
  119.             color.Green := $8000;
  120.             color.Blue := $8000;
  121.             Rgbforecolor(color);
  122.             END
  123.         ELSE
  124.             BEGIN
  125.             Penpat(Gray); 
  126.             END;
  127.         PenSize(4, 4);
  128.         SetRect(r, 50, 120, 250, 140);
  129.         FrameRoundRect(r, 10, 10);
  130.         PenNormal;
  131.         color.Red := $0000;
  132.         color.Green := $0000;
  133.         color.Blue := $0000;
  134.         RGBForeColor(color);
  135.         MoveTo(60, 135);
  136.         DrawString('Drawn through DeviceLoop');
  137.         END;
  138.  
  139.     PROCEDURE Button2;
  140.         VAR
  141.             userData: Longint;
  142.             flags: DeviceLoopFlags; {see Vol. VI, 21-24 }
  143.         BEGIN
  144.         userData := 0; {not used here}
  145.         flags := [];
  146.         DeviceLoop(gWP^.visRgn, @myDrawingProc, userData, flags);
  147.         END;
  148.  
  149.     PROCEDURE DoUpdate(evtWind: Windowptr);
  150.         VAR
  151.             savePort: Grafptr;
  152.         BEGIN
  153.         IF evtWind = gWP THEN
  154.             BEGIN
  155.             GetPort(savePort);
  156.             SetPort(gWP);
  157.             BeginUpdate(gWP);
  158. {•        EraseRect(gWP^.portRect);    •}
  159.              Button1;
  160.             Button2;
  161.             EndUpdate(gWP);
  162.             SetPort(savePort);
  163.             END;
  164.         END;
  165.  
  166.     PROCEDURE Maineventloop;
  167.         VAR
  168.             anEvent: EventRecord;
  169.             evtWind: WindowPtr;
  170.         BEGIN
  171.         REPEAT
  172.             IF WaitNextEvent(everyEvent, anEvent, 60, NIL) THEN
  173.                 CASE anEvent.what OF
  174.                     keyDown: gDone := True;
  175.                     MouseDown: DoMouseDown(anEvent.Where);
  176.                     updateEvt: DoUpdate(WindowPtr(anEvent.Message));
  177.                 END
  178.         UNTIL gDone;
  179.         END;
  180.  
  181.     BEGIN
  182.         InitMac;
  183.         InitApp;
  184.         MainEventLoop;
  185.     END.
  186.